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-- file Dllnterpreter .Mesa 

-- last modified by 

Sandman, April 9, 1978 12:37 AM 
Barbara, July 12, 1978 2:35 PM 



DIRECTORY 

DebugMiscDef 

DIActionDefs 

addressof I 

desc2I tern, 

incrementL 

memltem, m 

popevalsta 

pushtypest 

SearchFile 

setlnterva 

DIDefs: FROM 

ConstOrQua 

ParseObjec 

DILALRDefs: 

DILitDefs: F 



s: FROM "debugmi 
: FROM "diaction 
tem, assignvalue 

evaluateExpList 
ist, lengthltem, 
inusltem, NILesp 
ck, poptypestack 
ack, qualifyltem 
ForType, SearchF 
IBit, setPredefi 

"didefs" USING 
1 , DescriptorAss 
t, QueueProcesso 
FROM "dilalrdefs 
ROM "dilitdefs" 



scdefs" USING [WriteEOL], 
defs" USING [ 

, baseltem, CleanUp, dereferenceltem, desclltem, 
, getLiteral, getLongLiteral , getStringLiteral , 
Lookupid, loopholeltem, loopholeUnspecItem, 
, performAddOp , performMul tOp , poin tertoType, 
, printlnterval , printOctal, pusheval stack, 
, ResetStacks, SearchFileForld, 
orType, SearchForVariantType , SearchFrameForld , 
ned, startList, typeOp], 

[ 

igner. Operator, ParseError, ParseHandle, 

r, thereESPointer] , 

" USING [ActionEntry, Productioninf o] , 

USING [LTIndex, STIndex]; 



Dllnterpreter: PROGRAM 

IMPORTS DebugMiscDefs, DIActionDefs, DIDefs 
EXPORTS DIDefs 
SHARES DILALRDefs « 
BEGIN 

v: DESCRIPTOR FOR ARRAY OF UNSPECIFIED; --parse stack 

1: DESCRIPTOR FOR ARRAY OF CARDINAL; --source! ine index 

h: DESCRIPTOR FOR ARRAY OF DIDefs .ConstOrQua! ; --alternate stack 

q: DESCRIPTOR FOR ARRAY OF DILALRDefs .ActionEntry ; --reduction rules 

proddata: DESCRIPTOR FOR ARRAY OF DILALRDefs . Productioninf o; --production rules 

parse: DIDefs .ParseObject <- [qp: QueueProcessing, 
da: AssignDescr iptors]; 

TwoParse: PUBLIC PROCEDURE RETURNS [DIDefs .ParseHandl e] « 
BEGIN RETURN[@parse]; END; 



AssignDescriptors: DIDefs .DescriptorAssigner « 
BEGIN q ♦- qd; v <- vd; 1 ^ Id; proddata <- pd; h 

-- the interpretation rules 



hd; RETURN END; 



QueueProcessing: PUBLIC DIDefs. QueueProcessor* 
BEGIN OPEN DIActionDefs, DIDefs; 
rule: [0. .377B]; 
i: CARDINAL; 
FOR i IN [0. .ql) 

DO 

top *- top-q[i] . rtag.plength + 1; 

rule <- proddata[q[i] . transition] .rule; 

IF parsinglnterval THEN CheckRuleForlnterval [rule, top]; 

SELECT rule FROM 



=> -- goal 
-- no action 
EXIT; 



stmtl ist 



1 => -■- stmtl ist ::» stmt 
-- all finished 

BEGIN CleanUp[]: DebugMiscDef s .WriteEOL[] ; END; 

2 => -- stmtlist ::= stmtlist ; stmt 
-- clear the way for the next statement 

BEGIN DebugMiscDefs. WriteEOL[]; ResetStacks[] ; END; 

3 «> -- stmt : : « exp 

-- apply proc to the value of exp 
proc[popevalstack[ 1 NILesp => CONTINUE]]; 

4 «> -~ stmt ::« Ihs +- exp 

-- take value of exp from stack, store into address of Ihs 

BEGIN 

IF h[top] # var THEN SIGNAL DIDefs . ParseError[l[top]]; 
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assignva1ue[popevalstack[], L00PH0LE[popeva1 stack[3, thereESPointer]]; 
END; 

5 «> -- exp : :■ sum 

NULL; 

20 ■> -- sum : :« product 
NULL; 

21 »> -- sum ::« sum addop product 

-- combine two values on stack with addop, put result on stack 

BEGIN 

IF h[top] » var OR h[top+2] » var THEN h[top] ^ var; 

pusheva1stack[performAddOp[popevalstack[], popeval stack [],LOOPHOLE[v[top+l], Operator]]]; 

END; 

22 => -- addop : :■ + 
-- put plus on stack 

v[top] ^ Operator[plus]; 

23 «> -- addop : := - 
-- put minus on stack 
v[top] *- Operator[minus] ; 

24 => -- product ::« factor 
NULL; 

25 «> -- product ::= product muHop factor 

-- combine two values on stack with multop, put result on stack 

BEGIN 

IF h[top] = var OR h[top+2] = var THEN h[top] <- var; 

pusheval stack[perf ormMul tOp[ popeval stack[] , popeval stack[] , LOOPHOLE [v[top+l] , Operator]]]; 

END; 

26 => -- multop : :« * 
-- put times on stack 

v[top] <- OpGrator[times]; 

27 => -- multop : :« / 
-- put div on stack 

v[top] ^ Operator[div]; 

28 »> -- multop : := MOD 
-- put mod on stack 

v[top] <- Operator[mod]; 

30 => -- factor ::» primary 
NULL; 

31 => -- factor ::= - primary 
-- take value off stack, put back -value 
BEGIN 

h[top] ^ h[top+l]; 

pusheval stack[minusItem[popevalstack[]]]; 

END; 

40 => -- primary : : = Ihs 
NULL; 

41 «> -- primary ::= ( exp ) 
-- noop 

h[top] <- h[top + l]; 

43 => -- primary : : =« builtincall 
NULL; 

44 => -- primary : : »0 Ihs 
-- put address of value onto stack 
BEGIN 

IF h[top+l] ^ var THEN SIGNAL DIDef s . ParseError[l [top]] ELSE h[top] <- var; 
pusheval stack[addressof ItGm[LOOPHOLE[popevalstack[], thereESPointer]]]; 
END; 

50 «> -- builtincall ::« LENGTH [ Ihs ] 

-- evaluate LENGTH of id on stack, put back ^ of elements 
BEGIN 
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IF h[top+2] # var THEN SIGNAL DIDef s . ParseError[l [top]] ELSE h[top] ♦- var; 

pushevals back[lengthItein[popeva1stack[]]]; 

END; 

51 "> -- buiUincall ::» BASE [ Ihs ] 

~- evaluate BASE of id on stack, put back pointer value 

BEGIN 

IF h[top+2] # var THEN SIGNAL DIDef s . ParseError[l [top]] ELSE h[top] ^ var; 

pushevalstack[baseItem[popevalstack[]]]; 

END; 

52 -> ~- buiUincall ::- DESCRIPTOR [ exp ] 

-- create a DESCRIPTOR for id on stack, put back [loc, length] 

BEGIN 

IF h[top+2] i^ var THEN SIGNAL DIDef s . ParseError[l [top]] ELSE h[top] ^ var; 

pushevalstack[desclItem[LOOPHOLE[popevalstack[], thereESPointer]]]; 

END; 

53 »> -- buiUincall ::= DESCRIPTOR [ exp , exp ] 

-- create a DESCRIPTOR for id on stack, put back [loc, length] 

BEGIN 

h[top] <- var; 

pushevalstack[desc2Item[popevalstack[], popevalstack[]]] ; 

END; 

54 => -- buiUincall ::= typeop [ typespec ] 

-- apply typeop to value on typestack, put result on evalstack 

BEGIN 

h[top] <- var; 

pushevals t ack[typeOp[ LOOPHOLE [v[ top] , Operator], pop ty pest ack[]]]; 

END; 

65 => -- typeop ::« SIZE 

-- save operator - value not yet on stack 
v[top] <- Operator[size]; 

71 => -- Ihs : :- id 

lookup id, save info with its value 
BEGIN 

h[top] <- var; 

pushevalstack[LookupId[LOOPHOLE[v[top], DILitDef s .STIndex]]] ; 
END; 

72 ■> -- Ihs ::» num 

"- put value of numeric literal on stack as UNSPECIFIED 

BEGIN 

h[top] <- num; 

pushevalstack[getLiteral[num, LOOPHOLE[v[top] , DILitDef s.LTIndex]]]; 

END; 

73 => -- Ihs : := Inum 

put value of long numeric literal on stack a.s LONG INTEGER 
BEGIN 

h[top] <- Inum; 

p ushevalstack[getLongLiteral [LOOPHOLE [v[ top], DILitDef s .LTIndex]]]; 
END; 

74 => -- Ihs : := char 

-~ put value of character literal on stack as CHARACTER 

BEGIN 

h[top] ^ char; 

pushevalstack[getLiteral[char, LOOPHOLE[v[top] , DILitDef s .LTIndex]]]; 

END; 

75«>--lhs ::«sr 

-- put value of string literal on stack as Substring 

BEGIN 

h[top] *- sr; 

pushevalstack[getStringLiteral[LOOPHOLE[v[top], DILitDef s. STIndex]]]; 

END; 

76 «> --" Ihs ::« ( exp ) qualifier 

-~ noop 

SELECT h[top+l] FROM 
Inum, num, char «> 
SELECT h[top-H3] FROM 
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deref, loophole, loopholetype ■> h[top] ^ van; 

ENDCASE »> SIGNAL DIDef s . ParseError[l [top]] ; 
sr -> 

SELECT h[top+3] FROM 

deref, loophole, loopholetype, explist »> h[top] <- var; 

ENDCASE «> SIGNAL DIDeFs . ParseError[l [top]] ; 
ENDCASE; 

77 => -- Ihs ::■ Ihs qualifier 

-- noop 

SELECT h[top] FROM 
Inum, num. char ■> 
SELECT h[top+l] FROM 

deref, loophole, loopholetype •»> h[top] <- var; 
ENDCASE «> SIGNAL DIDef s . ParseError[l [top]] ; 
sr => 

SELECT h[top+l] FROM 

deref, loophole, loopholetype, explist «> h[top] > var; 
ENDCASE => SIGNAL DIDef s . ParseError[l [top]] ; 
ENDCASE; 

80 «> -- Ihs ::» MEMORY [ interval ] 

-- find values in MEMORY for interval - only valid at top level 

BEGIN 

h[top] *- num; 

printOctal [popevalstack[], popevalstack[]]; 

END; 

81 «> -- Ihs : := MEMORY [ exp ] 
-- find value in MEMORY for exp 

BEGIN 

h[top] *- var; 

pushevalstack[memIteni[popevalstack[]]] ; 

END; 

83 => -- Ihs : := id $ id 

-~ go to file named by first id to lookup second id 

BEGIN 

h[top] <- var; 

pushevalstack[SearchFileForId[v[top]. v[top+2]]]; 

END; 

84 => -- Ihs : := num $ id 

-- go to file named by global frame num to lookup second id 

BEGIN 

h[top] *- var; 

pushevalstack[SearchFrameForId[LOOPHOLE[v[top], DILitDef s .LTIndex] , v[top+2]]]; 

END; 

90 => -- qualifier : : » . id 
-- put field of record on stack 
BEGIN 

h[top] <- dot; 

pushevalstack[qual if yltem[ LOOPHOLE [ pope valstack[] , t her eESPo inter] , 

LOOPHOLE[v[top+l], DILitDefs.STIndex], locals]]; 
END; 

91 => -- qual if ier : : « t 
-- dereference value on stack 
BEGIN 

h[top] +- deref; 

pu s he val stack [dereference I tem[ LOOPHOLE [pope valstack[], thereESPointer]]]; 

END; 

92 => -- qual i Fier : : « % 

-~ loophole value to be an UNSPECIFIED 

BEGIN 

h[top] <- loophole; 

pushevalstack[loopholeUnspecItem[popevalstack[]]]; 

END; 

93 «> ~- qualifier ::« % typespec 

-- change type of value on stack to be typespec 

BEGIN 

h[top] ♦- loopholetype; 

pushevalstack[loophol el tem[popevalstack[], pop types tack[]]]; 
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END; 

94 ■> -- qualifier ::« [ explist ] 

-- qualify value on stack (procedure or array or string) - note listsize 

BEGIN 

h[top] ^ explist; 

pusheva1stack[evaluateExpList[]]; 

END; 

95 -> -- qualifier ::» [ interval ] 

-- apply interval op to value - valid only at top level 

BEGIN 

h[top] ^ interval ; 

printInterval[popevalstack[], popevalstack[3. popevalstack[]] ; 

END; 

105 «> -- typespec ::« typeid 
NULL; 

107 »> -- typespec ::» typeconstruct 
NULL; 

110 => -- typeid : :- INTEGER 
-- save type of INTEGER; 
pushtypestack[setPredefined[ integer]]; 

111 »> -- typeid ::= CARDINAL 
-- save type of CARDINAL; 
pushtypestack[setPredefined[ cardinal]]; 

112 «> -- typeid ::= CHARACTER 
-- save type of CHARACTER; 

push ty pes tack[ set Predefined [character]] ; 

113 => -- typeid ::= BOOLEAN 
-- save type of BOOLEAN; 

push types tack[setP redefined [boolean]]; 

114 »> -- typeid : :» STRING 
-- save type of STRING; 

push types tack [setPredefined[ string]] ; 

115 =»> -- typeid ::= UNSPECIFIED 
-- save type of UNSPECIFIED; 

push type stack [set Predefined [unspecified]]; 

116 => -- typeid : := id $ id 
-- go to file to find type 

pushtypestack[SearchFileForType[LOOPHOLE[v[top]. DILitDef s .STIndex] . L00PH0LE[v[top+2] . DILitDefs.S 
**TIndex]]]; 

119 => -- typeid : := id 
-- look for type 
pushtypestack[SearchForType[LOOPHOLE[v[top], DILitDef s .STIndex]]]; 

120 => -- typeid ::« id typeid 
-- add the variant to the type 

pu s hty pes tack [Sear chF or Vari ant Type[LOOPHOLE[v[ top] , DILitDef s .STIndex] , poptypestack[]]]; 

125 => -- typeconstruct ::= typespec 
-- construct a POINTER TO TYPE for typespec 
pus htypes tack [pointertoType[ pop types tack[]]]; 

140 => -- explist : := exp 
-- start 1 ist 
pushevalstack[startList[l]]; 

141 »> -- explist ::» explist , exp 
-- increment list size 
incrementList[]; 

142 «> -- expl ist : :■ 
-- empty expression list 
pushevalstack[startList[0]]; 

143 «> -- interval ::« exp .. exp 
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-- noop - have start address and Finish address on stack already 

BEGIN 

parsinglnterval ^ TRUE; 

intervalState *- interval; 

intervalRule ^ 0; 

END; 

144 B> -~ interval ::■ exp I exp 
-- note interval type 
BEGIN 

parsinglnterval <- TRUE; 
intervalState *- interval; 
intervalRule ♦- 0; 

pushevalstack[setIntervalBit[popevalstack[]]] ; 
END; 

ENDCASE => SIGNAL ParseError[l [top]] ; -- error or unimplemented 
ENDLOOP; 
RETURN 
END; 



-- Interval Checking 

parsinglnterval: BOOLEAN *• FALSE; 

NextlntervalRule: PACKED ARRAY [0..5] OF [0..377B] =» [ 
40 , -- primary : := Ihs 
30, -- factor ::= primary 
24, -- product ::« factor 
20, -- sum : :« product 
sum 
» exp 



5, ~- exp 
3]; -- stmt 



intervalState: {primary, interval, qualifier}; 

intervalRule: CARDINAL; 

CheckRuleForlnterval: PROCEDURE [rule: [0..377B], top: CARDINAL] » 
BEGIN 

IF rule < 3 THEN BEGIN parsinglnterval ^ FALSE; RETURN END; 
BEGIN 

SELECT intervalState FROM 
primary «=> 

SELECT rule FROM 

NextIntervalRule[intervalRule] «> intervalRule ♦- intervalRule + 1; 
ENDCASE => GO TO Error; 
interval => 

SELECT rule FROM 

80 «> intervalState <- primary; 
95 => intervalState <- qualifier; 
ENDCASE => GO TO Error; 
qualifier «> 

SELECT rule FROM 

77, 76 «> intervalState ♦- primary; 
ENDCASE «> GO TO Error; 
ENDCASE => ERROR; 
EXITS 
Error => 
BEGIN 

parsinglnterval <- FALSE; 
SIGNAL DIDefs.ParseError[l[top]]; 
END; 
END; 
RETURN 
END; 

END. . . 



